home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / slatex / proctex.ss < prev    next >
Text File  |  1993-11-07  |  6KB  |  183 lines
  1. ;proctex.ss
  2. ;SLaTeX Version 1.99
  3. ;Implements SLaTeX's piggyback to LaTeX
  4. ;(c) Dorai Sitaram, December 1991, Rice University
  5.  
  6. (define disable-slatex-temply
  7.   (lambda (in)
  8.     ;tell slatex that it should not process slatex commands till
  9.     ;the enabling control sequence is called
  10.     (set! *slatex-enabled?* #f)
  11.     (set! *slatex-reenabler* (read-grouped-latexexp in))))
  12.  
  13. (define enable-slatex-again
  14.   (lambda ()
  15.     ;tell slatex to resume processing slatex commands
  16.     (set! *slatex-enabled?* #t)
  17.     (set! *slatex-reenabler* "UNDEFINED")))
  18.  
  19. (define ignore2 
  20.   (lambda (i ii)
  21.     ;ignores its two arguments
  22.     'void))
  23.  
  24. (define add-to-slatex-db
  25.   (lambda (in categ)
  26.     ;some scheme identifiers to be added to the token category categ
  27.     (if (memq categ '(keyword constant variable))
  28.     (add-to-slatex-db-basic in categ)
  29.     (add-to-slatex-db-special in categ))))
  30.  
  31. (define add-to-slatex-db-basic
  32.   (lambda (in categ)
  33.     ;read the following scheme identifiers and add them to the
  34.     ;token category categ
  35.     (let ((setter (cond ((eq? categ 'keyword) set-keyword)
  36.             ((eq? categ 'constant) set-constant)
  37.             ((eq? categ 'variable) set-variable)
  38.             (else (lerror 'add-to-slatex-db-basic))))
  39.       (ids (read-grouped-schemeids in)))
  40.       (for-each setter ids))))
  41.  
  42. (define add-to-slatex-db-special
  43.   (lambda (in what)
  44.     ;read the following scheme identifier(s) and either
  45.     ;enable/disable its special-symbol status
  46.     (let ((ids (read-grouped-schemeids in)))
  47.       (cond ((eq? what 'unsetspecialsymbol)
  48.          (for-each unset-special-symbol ids))
  49.         ((eq? what 'setspecialsymbol)
  50.          (if (= (length ids) 1) 'ok
  51.            (lerror 'setspecialsymbol-takes-one-arg-only))
  52.          (let ((transl (read-grouped-latexexp in)))
  53.            (set-special-symbol (car ids) transl)))
  54.         (else (lerror 'add-to-slatex-db-special 2))))))
  55.  
  56. (define process-slatex-alias
  57.   (lambda (in what which)
  58.     ;add/remove a slatex control sequence name
  59.     (let ((triggerer (read-grouped-latexexp in)))
  60.       (cond ((eq? which 'intext)
  61.          (set! *intext-triggerers* 
  62.            (what triggerer *intext-triggerers*)))
  63.         ((eq? which 'resultintext)
  64.          (set! *resultintext-triggerers*
  65.            (what triggerer *resultintext-triggerers*)))
  66.         ((eq? which 'display)
  67.          (set! *display-triggerers* 
  68.            (what triggerer *display-triggerers*)))
  69.         ((eq? which 'box)
  70.          (set! *box-triggerers* 
  71.            (what triggerer *box-triggerers*)))
  72.         ((eq? which 'input)
  73.          (set! *input-triggerers* 
  74.            (what triggerer *input-triggerers*)))
  75.         ((eq? which 'region)
  76.          (set! *region-triggerers* 
  77.            (what triggerer *region-triggerers*)))
  78.         ((eq? which 'mathescape)
  79.          (if (= (string-length triggerer) 1) 'ok
  80.            (lerror 'math-escape-should-be-character))
  81.          (set! *math-triggerers*
  82.            (what (string-ref triggerer 0) *math-triggerers*)))
  83.         (else (lerror 'process-slatex-alias))))))
  84.  
  85. (define decide-latex-or-tex
  86.   (lambda (latex?)
  87.     ;create a (the first) .Z*.tex file, and place "latex" or "tex"
  88.     ;in it as appropriate; this is used afterward to call the right
  89.     ;command, i.e., latex or tex
  90.     (set! *latex?* latex?)
  91.     (let ((aux.tex (new-aux-file ".tex")))
  92.       (if (file-exists? aux.tex) (delete-file aux.tex))
  93.       (call-with-output-file aux.tex
  94.     (lambda (out)
  95.       (display (if latex? "latex" "tex") out))))))
  96.  
  97. (define process-include-only
  98.   (lambda (in)
  99.     ;remember the files mentioned by \includeonly
  100.     (for-each
  101.       (lambda (filename)
  102.     (let ((filename (full-texfile-name filename)))
  103.       (if filename
  104.         (set! *include-onlys*
  105.           (adjoin-string filename *include-onlys*)))))
  106.       (read-grouped-commaed-filenames in))))
  107.  
  108. (define process-documentstyle
  109.   (lambda (in)
  110.     ;process the .sty files corresponding to the documentstyle options
  111.     (eat-latex-whitespace in)
  112.     (if (char=? (peek-char in) #\[)
  113.       (for-each
  114.     (lambda (filename)
  115.       (fluid-let ((*slatex-in-protected-region?* #f))
  116.         (process-tex-file
  117.           (string-append filename ".sty"))))
  118.     (read-bktd-commaed-filenames in)))))
  119.  
  120. (define process-case-info
  121.   (lambda (in)
  122.     ;find out and tell slatex if the scheme tokens that differ
  123.     ;only by case should be treated identical or not
  124.     (let ((bool (read-grouped-latexexp in)))
  125.     (set! *slatex-case-sensitive?*
  126.       (cond ((string-ci=? bool "true") #t)
  127.         ((string-ci=? bool "false") #f)
  128.         (else (lerror 'bad-schemecasesensitive-arg)))))))
  129.  
  130. (define jobname 'forward)
  131.  
  132. (define seen-first-command? 'forward)
  133.  
  134. (define process-main-tex-file
  135.   (lambda (filename)
  136.     ;kick off slatex on the main .tex file filename
  137.     (display* #f eoln "SLaTeX Version 1.9999, Dec. 1991" eoln)
  138.     (set! *texinputs-list* (path->list *texinputs*))
  139.     (let ((filehide.jnk "filehide.jnk"))
  140.       (if (file-exists? filehide.jnk) (delete-file filehide.jnk))
  141.       (if (eq? *op-sys* 'dos)
  142.           (call-with-output-file filehide.jnk
  143.             (lambda (out)
  144.               (display* out "\\def\\filehider{x}" eoln)))))
  145.      (display* #f "typesetting code")
  146.     (set! jobname (basename filename ".tex"))
  147.     (set! seen-first-command? #f)
  148.     (process-tex-file filename)
  149.     (display* #f "done" eoln eoln)))
  150.  
  151. (define dump-intext
  152.   (lambda (in out)
  153.     (let* ((display (if out display ignore2))
  154.        (delim-char (begin (eat-whitespace in) (read-char in)))
  155.        (delim-char
  156.          (cond ((char=? delim-char #\{) #\})
  157.            (else delim-char))))
  158.       (if (eof-object? delim-char) (lerror 'dump-intext 1))
  159.       (let loop ()
  160.     (let ((c (read-char in)))
  161.       (if (eof-object? c) (lerror 'dump-intext 2))
  162.       (if (char=? c delim-char) 'done
  163.               (begin (display c out) (loop))))))))
  164.           
  165. (define dump-display
  166.   (lambda (in out ender)
  167.     (eat-tabspace in)
  168.     (let ((display (if out display ignore2))
  169.       (ender-lh (string-length ender))
  170.       (c (peek-char in)))
  171.       (if (eof-object? c) (lerror 'dump-display 1))
  172.       (if (char=? c #\newline) (read-char in))
  173.       (let loop ((buf ""))
  174.     (let ((c (read-char in)))
  175.       (if (eof-object? c) (lerror 'dump-display 2))
  176.       (let ((buf (string-append buf (string c))))
  177.         (if (string-prefix? buf ender) 
  178.         (if (= (string-length buf) ender-lh) 'done
  179.           (loop buf))
  180.         (begin (display buf out) (loop "")))))))))
  181.  
  182. ;continued on proctex2.ss
  183.